Os dados

set.seed(12345)

lastfm = read_csv(here::here("data/experimento-lastfm.csv"), 
                  col_types = cols(.default = col_double(), 
                                   user = col_character()))

lastfm = lastfm %>% 
  sample_n(300) %>% 
  select(news, old, mediana_pop)

glimpse(lastfm)
Observations: 300
Variables: 3
$ news        <dbl> 28, 35, 13, 24, 14, 17, 13, 21, 34, 55, 10, 33, 10, 217, 30, 36, 22, 21,…
$ old         <dbl> 61, 194, 70, 96, 130, 67, 106, 123, 76, 78, 76, 116, 119, 46, 102, 126, …
$ mediana_pop <dbl> 6.105585, 5.376812, 5.713082, 4.564335, 5.782320, 5.532590, 5.394389, 5.…

Proporção de artistas novos e popularidade

Utilizaremos ICs para estimar duas métricas sobre os usuários do LastFM em geral durante um período de 6 meses. Em ambos os casos faremos isso a partir de uma amostra de 300 usuários. As duas métricas são: 1. Qual a proporção de novos artistas em geral escutada por usuários? 2. Para os usuários que gostam de música muito pop (mediana_pop > 5), qual a correlação entre a popularidade mediana dos artistas escutado e a proporção dos artistas escutados que eram novos.

Perguntas

Os questionamentos levantados serão respondidos nos itens abaixo

1. Qual a proporção de novos artistas em geral escutada por usuários?

A média da proporção de novos artistas em geral escutada pelos usuários é dada pela variável theta_c:

set.seed(9098)

theta_c = lastfm %>% 
    mutate(news_prop = news/(news + old)) %>%
    pull(news_prop) %>%
    mean()

theta_c
[1] 0.2483568

Aplicando a técnica de bootstrap (com 3000 repetições) para calcular a média da proporção de artistas novos de amostras aleatórias retiradas da amostra principal, temos:

set.seed(9098)

repeticoes = 3000

bootstrap_q1 <- function(ds) {
  ds = ds %>% mutate(news_prop = news/(news + old))
  news_prop = ds %>% pull(news_prop)
  bootstrap <- sample(news_prop, size = NROW(news_prop), replace = TRUE)
  
  return(mean(bootstrap))
}

reamostragens = tibble(i = 1:repeticoes) %>% 
  mutate(theta_c_s = map_dbl(i, ~ bootstrap_q1(lastfm)))

Agora, vamos visualizar as reamostragens que obtivemos:

set.seed(9098)

graf_reamostragens_q1 = reamostragens %>%
  ggplot(aes(x = theta_c_s)) +
  geom_histogram(binwidth = .00125,
                 fill = "pink",
                 colour = "black")

ggplotly(graf_reamostragens_q1)

Pela visualização acima, além de percebermos que o gráfico segue uma distribuição normal, vemos que a maioria das médias das reamostras estão entre 24 e 26%.

Agora, calculando o intervalo de confiança (IC):

set.seed(9098)

ic_q1 = reamostragens %>% 
  mutate(erro = theta_c_s - theta_c) %>% 
  summarise(erro_i = quantile(erro, .05), 
            erro_s = quantile(erro, .95))

ic_q1 = ic_q1 %>% 
  mutate(valor_i = theta_c + erro_i, 
         valor_s = theta_c + erro_s)


ic_q1

Agora, vamos visualizar o IC (obtido com a técnica de bootstrap):

set.seed(9098)

graf_ic_q1 = ggplot() +
  geom_rect(
    data = ic_q1,
    aes(xmin = valor_i, xmax = valor_s),
    ymin = -Inf,
    ymax = Inf,
    fill = "lightgreen",
    alpha = .25
  ) +
  geom_histogram(
    data = reamostragens,
    aes(theta_c_s),
    binwidth = .0015,
    fill = "pink",
    colour = "black"
  ) +
  geom_vline(xintercept = theta_c, color = "blue")

graf_ic_q1

Dessa forma, podemos afirmar com 95% de confiança que, com uma amostra de 300 itens, a média populacional da proporção de novos artistas escutados pelos usuários será estimada entre 23,76 e 25,97%.

Agora, vamos comparar o resultado obtido com um bootstrapper já implementado pela biblioteca boot:

set.seed(9098)

theta <- function(d, i) {
    d = d %>% slice(i) %>%
        mutate(news_prop = news/(news + old)) %>% 
        summarise(media = mean(news_prop))
    
    m = d %>% pull(media)
    m
}

booted = boot(data = lastfm,
              statistic = theta,
              R = 3000)

ci = tidy(booted, 
          conf.level = .95,
          conf.method = "bca",
          conf.int = TRUE)

glimpse(ci)
Observations: 1
Variables: 5
$ statistic <dbl> 0.2483568
$ bias      <dbl> 0.0001609142
$ std.error <dbl> 0.006733435
$ conf.low  <dbl> 0.2356069
$ conf.high <dbl> 0.2616769

Utilizando um bootstrapper já implementado podemos ver que, com 95% de confiança, a média populacional da proporção de novos artistas escutados pelos usuários será estimada entre 23,56 e 26,16%. Esse intervalo obtido com um bootstrapper já implementado condiz com o que obtivemos previamente.

2. Para os usuários que gostam de música muito pop (mediana_pop > 5), qual a correlação entre a popularidade mediana dos artistas escutado e a proporção dos artistas escutados que eram novos.

Primeiramente, filtrando nossos dados (apenas usuários com mediana_pop > 5):

lastfm_q2 = lastfm %>% filter(mediana_pop > 5)
theta_q2 <- function(ds) {
    ds = ds %>% mutate(news_prop = news/(news + old))
    
    c <- cor(ds$news_prop, ds$mediana_pop)
    return(c)
}    

theta_c = theta_q2(lastfm_q2)

theta_c
[1] -0.088961

Como o valor obtido é próximo de zero, aparentemente não há nenhuma correlação.

Vamos agora visualizar um gráfico correlacionando as variáveis:

lastfm_q2 %>% mutate(news_prop = news/(news + old)) %>%
    ggplot(aes(x = news_prop, y = mediana_pop)) + 
    geom_point()

Vemos pontos muito dispersos, a correlação entre a popularidade mediana dos artistas escutado e a proporção dos artistas escutados que eram novos é baixa.

Realizando o bootstrapping:

set.seed(9098)

repeticoes = 3000

bootstrap_q2 <- function(ds) {
  ds = ds %>% mutate(news_prop = news/(news + old))
  
  bootstrap <- sample_n(ds, 
                        size = NROW(news_prop), 
                        replace = TRUE)
  
  return(cor(bootstrap$news_prop, bootstrap$mediana_pop))
}

reamostragens = tibble(i = 1:repeticoes) %>% 
    mutate(theta_c_s = map_dbl(i, ~ bootstrap_q2(lastfm_q2)))

graf_reamostragens_q2 = reamostragens %>%
  ggplot(aes(x = theta_c_s)) +
  geom_histogram(binwidth = .01,
                 colour = "black",
                 fill = "pink")

ggplotly(graf_reamostragens_q2)

Como há menos elementos em cada classe ocorreram mais resultados diferentes quando comparamos com a visualização das reamostragens feitas na questão anterior. Percebe-se também que a correlação é próxima bem próxima de 0 em todas as reamostragens.

Calculando o IC:

set.seed(9098)

ic_q2 = reamostragens %>% 
  mutate(erro = theta_c_s - theta_c) %>% 
  summarise(erro_i = quantile(erro, .05), 
            erro_s = quantile(erro, .95))

ic_q2 = ic_q2 %>% 
  mutate(valor_i = theta_c + erro_i, 
         valor_s = theta_c + erro_s)


ic_q2

Visualizando esse IC:

graf_ic_q2 = ggplot() +
  geom_rect(
    data = ic_q2,
    aes(xmin = valor_i, xmax = valor_s),
    ymin = -Inf,
    ymax = Inf,
    fill = "lightgreen",
    alpha = .25
  ) +
  geom_histogram(
    data = reamostragens,
    aes(theta_c_s),
    binwidth = .01,
    fill = "pink",
    colour = "black"
  ) +
  geom_vline(xintercept = theta_c, color = "blue")

graf_ic_q2

Observamos com 95% de confiança que, a correlação entre a popularidade mediana dos artistas escutado e a proporção dos artistas escutados que eram novos está estimada entre -0,2 e 0,026. Como esse intervalo contém o valor 0, pode-se afirmar que, caso a correlação exista (pode acontecer da correlação ser zero), ela é bem próximo de zero.

Agora, vamos comparar utilizando o bootstrapper da biblioteca boot:

set.seed(9098)

theta <- function(d, i) {
    d = d %>% slice(i) %>%
        mutate(news_prop = news/(news + old)) %>% 
        summarise(cor = cor(news_prop, mediana_pop))
    
    c = d %>% pull(cor)
    c
}

booted = boot(data = lastfm_q2,
              statistic = theta,
              R = 3000)

ci = tidy(booted, 
          conf.level = .95,
          conf.method = "bca",
          conf.int = TRUE)

glimpse(ci)
Observations: 1
Variables: 5
$ statistic <dbl> -0.088961
$ bias      <dbl> 0.002479051
$ std.error <dbl> 0.06877761
$ conf.low  <dbl> -0.2259757
$ conf.high <dbl> 0.04092692

Com um bootstrapper já implementado, obtemos que, com 95% de confiança, a correlação entre a popularidade mediana dos artistas escutado e a proporção dos artistas escutados que eram novos está estimada entre -0,23 e 0,041%. Novamente percebemos que o zero está contido no intervalo, o que indica que a correlação pode não existir ou ser muito baixa.

LS0tCnRpdGxlOiAiQUQxL0NERCAtIExhYi4gMDMsIHBhcnRlIDAyIC0gSW1wbGVtZW50YW5kbyBJQ3MiCmF1dGhvcjogIkZyYW5jaXNjbyBFZGV2ZXJ0b24gZGUgQWxtZWlkYSBKw7puaW9yIgpkYXRlOiAiMTQgZGUganVsaG8gZGUgMjAxOSIKb3V0cHV0OgogIGh0bWxfZG9jdW1lbnQ6CiAgICB0aGVtZTogcmVhZGFibGUKICAgIGRmX3ByaW50OiBwYWdlZAogICAgdG9jOiB5ZXMKICBodG1sX25vdGVib29rOgogICAgZmlnX3dpZHRoOiA3CiAgICB0aGVtZTogcmVhZGFibGUKICAgIHRvYzogeWVzCiAgICB0b2NfZmxvYXQ6IHllcwotLS0KCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFLCBtZXNzYWdlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUpCmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KGJvb3QpCmxpYnJhcnkoYnJvb20pCmxpYnJhcnkocGxvdGx5KQp0aGVtZV9zZXQodGhlbWVfYncoKSkKYGBgCgojIyBPcyBkYWRvcwoKYGBge3J9CnNldC5zZWVkKDEyMzQ1KQoKbGFzdGZtID0gcmVhZF9jc3YoaGVyZTo6aGVyZSgiZGF0YS9leHBlcmltZW50by1sYXN0Zm0uY3N2IiksIAogICAgICAgICAgICAgICAgICBjb2xfdHlwZXMgPSBjb2xzKC5kZWZhdWx0ID0gY29sX2RvdWJsZSgpLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB1c2VyID0gY29sX2NoYXJhY3RlcigpKSkKCmxhc3RmbSA9IGxhc3RmbSAlPiUgCiAgc2FtcGxlX24oMzAwKSAlPiUgCiAgc2VsZWN0KG5ld3MsIG9sZCwgbWVkaWFuYV9wb3ApCgpnbGltcHNlKGxhc3RmbSkKYGBgCgojIyBQcm9wb3LDp8OjbyBkZSBhcnRpc3RhcyBub3ZvcyBlIHBvcHVsYXJpZGFkZQoKVXRpbGl6YXJlbW9zIElDcyBwYXJhIGVzdGltYXIgZHVhcyBtw6l0cmljYXMgc29icmUgb3MgdXN1w6FyaW9zIGRvIExhc3RGTSBlbSBnZXJhbCBkdXJhbnRlIHVtIHBlcsOtb2RvIGRlIDYgbWVzZXMuIEVtIGFtYm9zIG9zIGNhc29zIGZhcmVtb3MgaXNzbyBhIHBhcnRpciBkZSB1bWEgYW1vc3RyYSBkZSAzMDAgdXN1w6FyaW9zLiBBcyBkdWFzIG3DqXRyaWNhcyBzw6NvOiAKICAxLiBRdWFsIGEgcHJvcG9yw6fDo28gZGUgbm92b3MgYXJ0aXN0YXMgZW0gZ2VyYWwgZXNjdXRhZGEgcG9yIHVzdcOhcmlvcz8KICAyLiBQYXJhIG9zIHVzdcOhcmlvcyBxdWUgZ29zdGFtIGRlIG3DunNpY2EgbXVpdG8gcG9wIChtZWRpYW5hX3BvcCA+IDUpLCBxdWFsIGEgY29ycmVsYcOnw6NvIGVudHJlIGEgcG9wdWxhcmlkYWRlIG1lZGlhbmEgZG9zIGFydGlzdGFzIGVzY3V0YWRvIGUgYSBwcm9wb3LDp8OjbyBkb3MgYXJ0aXN0YXMgZXNjdXRhZG9zIHF1ZSBlcmFtIG5vdm9zLiAKCiMjIFBlcmd1bnRhcwpPcyBxdWVzdGlvbmFtZW50b3MgbGV2YW50YWRvcyBzZXLDo28gcmVzcG9uZGlkb3Mgbm9zIGl0ZW5zIGFiYWl4bwoKIyMjIDEuIFF1YWwgYSBwcm9wb3LDp8OjbyBkZSBub3ZvcyBhcnRpc3RhcyBlbSBnZXJhbCBlc2N1dGFkYSBwb3IgdXN1w6FyaW9zPwpBIG3DqWRpYSBkYSBwcm9wb3LDp8OjbyBkZSBub3ZvcyBhcnRpc3RhcyBlbSBnZXJhbCBlc2N1dGFkYSBwZWxvcyB1c3XDoXJpb3Mgw6kgZGFkYSBwZWxhIHZhcmnDoXZlbCB0aGV0YV9jOgpgYGB7cn0Kc2V0LnNlZWQoOTA5OCkKCnRoZXRhX2MgPSBsYXN0Zm0gJT4lIAogICAgbXV0YXRlKG5ld3NfcHJvcCA9IG5ld3MvKG5ld3MgKyBvbGQpKSAlPiUKICAgIHB1bGwobmV3c19wcm9wKSAlPiUKICAgIG1lYW4oKQoKdGhldGFfYwpgYGAKCkFwbGljYW5kbyBhIHTDqWNuaWNhIGRlIGJvb3RzdHJhcCAoY29tIDMwMDAgcmVwZXRpw6fDtWVzKSBwYXJhIGNhbGN1bGFyIGEgbcOpZGlhIGRhIHByb3BvcsOnw6NvIGRlIGFydGlzdGFzIG5vdm9zIGRlIGFtb3N0cmFzIGFsZWF0w7NyaWFzIHJldGlyYWRhcyBkYSBhbW9zdHJhIHByaW5jaXBhbCwgdGVtb3M6CmBgYHtyfQpzZXQuc2VlZCg5MDk4KQoKcmVwZXRpY29lcyA9IDMwMDAKCmJvb3RzdHJhcF9xMSA8LSBmdW5jdGlvbihkcykgewogIGRzID0gZHMgJT4lIG11dGF0ZShuZXdzX3Byb3AgPSBuZXdzLyhuZXdzICsgb2xkKSkKICBuZXdzX3Byb3AgPSBkcyAlPiUgcHVsbChuZXdzX3Byb3ApCiAgYm9vdHN0cmFwIDwtIHNhbXBsZShuZXdzX3Byb3AsIHNpemUgPSBOUk9XKG5ld3NfcHJvcCksIHJlcGxhY2UgPSBUUlVFKQogIAogIHJldHVybihtZWFuKGJvb3RzdHJhcCkpCn0KCnJlYW1vc3RyYWdlbnMgPSB0aWJibGUoaSA9IDE6cmVwZXRpY29lcykgJT4lIAogIG11dGF0ZSh0aGV0YV9jX3MgPSBtYXBfZGJsKGksIH4gYm9vdHN0cmFwX3ExKGxhc3RmbSkpKQpgYGAKCkFnb3JhLCB2YW1vcyB2aXN1YWxpemFyIGFzIHJlYW1vc3RyYWdlbnMgcXVlIG9idGl2ZW1vczoKYGBge3J9CnNldC5zZWVkKDkwOTgpCgpncmFmX3JlYW1vc3RyYWdlbnNfcTEgPSByZWFtb3N0cmFnZW5zICU+JQogIGdncGxvdChhZXMoeCA9IHRoZXRhX2NfcykpICsKICBnZW9tX2hpc3RvZ3JhbShiaW53aWR0aCA9IC4wMDEyNSwKICAgICAgICAgICAgICAgICBmaWxsID0gInBpbmsiLAogICAgICAgICAgICAgICAgIGNvbG91ciA9ICJibGFjayIpCgpnZ3Bsb3RseShncmFmX3JlYW1vc3RyYWdlbnNfcTEpCmBgYApQZWxhIHZpc3VhbGl6YcOnw6NvIGFjaW1hLCBhbMOpbSBkZSBwZXJjZWJlcm1vcyBxdWUgbyBncsOhZmljbyBzZWd1ZSB1bWEgZGlzdHJpYnVpw6fDo28gbm9ybWFsLCB2ZW1vcyBxdWUgYSBtYWlvcmlhIGRhcyBtw6lkaWFzIGRhcyByZWFtb3N0cmFzIGVzdMOjbyBlbnRyZSAyNCBlIDI2JS4KCkFnb3JhLCBjYWxjdWxhbmRvIG8gaW50ZXJ2YWxvIGRlIGNvbmZpYW7Dp2EgKElDKToKYGBge3J9CnNldC5zZWVkKDkwOTgpCgppY19xMSA9IHJlYW1vc3RyYWdlbnMgJT4lIAogIG11dGF0ZShlcnJvID0gdGhldGFfY19zIC0gdGhldGFfYykgJT4lIAogIHN1bW1hcmlzZShlcnJvX2kgPSBxdWFudGlsZShlcnJvLCAuMDUpLCAKICAgICAgICAgICAgZXJyb19zID0gcXVhbnRpbGUoZXJybywgLjk1KSkKCmljX3ExID0gaWNfcTEgJT4lIAogIG11dGF0ZSh2YWxvcl9pID0gdGhldGFfYyArIGVycm9faSwgCiAgICAgICAgIHZhbG9yX3MgPSB0aGV0YV9jICsgZXJyb19zKQoKCmljX3ExCmBgYAoKQWdvcmEsIHZhbW9zIHZpc3VhbGl6YXIgbyBJQyAob2J0aWRvIGNvbSBhIHTDqWNuaWNhIGRlIGJvb3RzdHJhcCk6CmBgYHtyfQpzZXQuc2VlZCg5MDk4KQoKZ3JhZl9pY19xMSA9IGdncGxvdCgpICsKICBnZW9tX3JlY3QoCiAgICBkYXRhID0gaWNfcTEsCiAgICBhZXMoeG1pbiA9IHZhbG9yX2ksIHhtYXggPSB2YWxvcl9zKSwKICAgIHltaW4gPSAtSW5mLAogICAgeW1heCA9IEluZiwKICAgIGZpbGwgPSAibGlnaHRncmVlbiIsCiAgICBhbHBoYSA9IC4yNQogICkgKwogIGdlb21faGlzdG9ncmFtKAogICAgZGF0YSA9IHJlYW1vc3RyYWdlbnMsCiAgICBhZXModGhldGFfY19zKSwKICAgIGJpbndpZHRoID0gLjAwMTUsCiAgICBmaWxsID0gInBpbmsiLAogICAgY29sb3VyID0gImJsYWNrIgogICkgKwogIGdlb21fdmxpbmUoeGludGVyY2VwdCA9IHRoZXRhX2MsIGNvbG9yID0gImJsdWUiKQoKZ3JhZl9pY19xMQpgYGAKRGVzc2EgZm9ybWEsIHBvZGVtb3MgYWZpcm1hciBjb20gOTUlIGRlIGNvbmZpYW7Dp2EgcXVlLCBjb20gdW1hIGFtb3N0cmEgZGUgMzAwIGl0ZW5zLCBhIG3DqWRpYSBwb3B1bGFjaW9uYWwgZGEgcHJvcG9yw6fDo28gZGUgbm92b3MgYXJ0aXN0YXMgZXNjdXRhZG9zIHBlbG9zIHVzdcOhcmlvcyBzZXLDoSBlc3RpbWFkYSBlbnRyZSAyMyw3NiBlIDI1LDk3JS4KCkFnb3JhLCB2YW1vcyBjb21wYXJhciBvIHJlc3VsdGFkbyBvYnRpZG8gY29tIHVtIGJvb3RzdHJhcHBlciBqw6EgaW1wbGVtZW50YWRvIHBlbGEgYmlibGlvdGVjYSBib290OgpgYGB7cn0Kc2V0LnNlZWQoOTA5OCkKCnRoZXRhIDwtIGZ1bmN0aW9uKGQsIGkpIHsKICAgIGQgPSBkICU+JSBzbGljZShpKSAlPiUKICAgICAgICBtdXRhdGUobmV3c19wcm9wID0gbmV3cy8obmV3cyArIG9sZCkpICU+JSAKICAgICAgICBzdW1tYXJpc2UobWVkaWEgPSBtZWFuKG5ld3NfcHJvcCkpCiAgICAKICAgIG0gPSBkICU+JSBwdWxsKG1lZGlhKQogICAgbQp9Cgpib290ZWQgPSBib290KGRhdGEgPSBsYXN0Zm0sCiAgICAgICAgICAgICAgc3RhdGlzdGljID0gdGhldGEsCiAgICAgICAgICAgICAgUiA9IDMwMDApCgpjaSA9IHRpZHkoYm9vdGVkLCAKICAgICAgICAgIGNvbmYubGV2ZWwgPSAuOTUsCiAgICAgICAgICBjb25mLm1ldGhvZCA9ICJiY2EiLAogICAgICAgICAgY29uZi5pbnQgPSBUUlVFKQoKZ2xpbXBzZShjaSkKYGBgClV0aWxpemFuZG8gdW0gYm9vdHN0cmFwcGVyIGrDoSBpbXBsZW1lbnRhZG8gcG9kZW1vcyB2ZXIgcXVlLCBjb20gOTUlIGRlIGNvbmZpYW7Dp2EsIGEgbcOpZGlhIHBvcHVsYWNpb25hbCBkYSBwcm9wb3LDp8OjbyBkZSBub3ZvcyBhcnRpc3RhcyBlc2N1dGFkb3MgcGVsb3MgdXN1w6FyaW9zIHNlcsOhIGVzdGltYWRhIGVudHJlIDIzLDU2IGUgMjYsMTYlLiBFc3NlIGludGVydmFsbyBvYnRpZG8gY29tIHVtIGJvb3RzdHJhcHBlciBqw6EgaW1wbGVtZW50YWRvIGNvbmRpeiBjb20gbyBxdWUgb2J0aXZlbW9zIHByZXZpYW1lbnRlLgoKIyMjIDIuIFBhcmEgb3MgdXN1w6FyaW9zIHF1ZSBnb3N0YW0gZGUgbcO6c2ljYSBtdWl0byBwb3AgKG1lZGlhbmFfcG9wID4gNSksIHF1YWwgYSBjb3JyZWxhw6fDo28gZW50cmUgYSBwb3B1bGFyaWRhZGUgbWVkaWFuYSBkb3MgYXJ0aXN0YXMgZXNjdXRhZG8gZSBhIHByb3BvcsOnw6NvIGRvcyBhcnRpc3RhcyBlc2N1dGFkb3MgcXVlIGVyYW0gbm92b3MuIApQcmltZWlyYW1lbnRlLCBmaWx0cmFuZG8gbm9zc29zIGRhZG9zIChhcGVuYXMgdXN1w6FyaW9zIGNvbSBtZWRpYW5hX3BvcCA+IDUpOgpgYGB7cn0KbGFzdGZtX3EyID0gbGFzdGZtICU+JSBmaWx0ZXIobWVkaWFuYV9wb3AgPiA1KQpgYGAKCmBgYHtyfQp0aGV0YV9xMiA8LSBmdW5jdGlvbihkcykgewogICAgZHMgPSBkcyAlPiUgbXV0YXRlKG5ld3NfcHJvcCA9IG5ld3MvKG5ld3MgKyBvbGQpKQogICAgCiAgICBjIDwtIGNvcihkcyRuZXdzX3Byb3AsIGRzJG1lZGlhbmFfcG9wKQogICAgcmV0dXJuKGMpCn0gICAgCgp0aGV0YV9jID0gdGhldGFfcTIobGFzdGZtX3EyKQoKdGhldGFfYwpgYGAKQ29tbyBvIHZhbG9yIG9idGlkbyDDqSBwcsOzeGltbyBkZSB6ZXJvLCBhcGFyZW50ZW1lbnRlIG7Do28gaMOhIG5lbmh1bWEgY29ycmVsYcOnw6NvLgoKVmFtb3MgYWdvcmEgdmlzdWFsaXphciB1bSBncsOhZmljbyBjb3JyZWxhY2lvbmFuZG8gYXMgdmFyacOhdmVpczoKYGBge3J9Cmxhc3RmbV9xMiAlPiUgbXV0YXRlKG5ld3NfcHJvcCA9IG5ld3MvKG5ld3MgKyBvbGQpKSAlPiUKICAgIGdncGxvdChhZXMoeCA9IG5ld3NfcHJvcCwgeSA9IG1lZGlhbmFfcG9wKSkgKyAKICAgIGdlb21fcG9pbnQoKQpgYGAKVmVtb3MgcG9udG9zIG11aXRvIGRpc3BlcnNvcywgYSBjb3JyZWxhw6fDo28gZW50cmUgYSBwb3B1bGFyaWRhZGUgbWVkaWFuYSBkb3MgYXJ0aXN0YXMgZXNjdXRhZG8gZSBhIHByb3BvcsOnw6NvIGRvcyBhcnRpc3RhcyBlc2N1dGFkb3MgcXVlIGVyYW0gbm92b3Mgw6kgYmFpeGEuCgpSZWFsaXphbmRvIG8gYm9vdHN0cmFwcGluZzoKYGBge3J9CnNldC5zZWVkKDkwOTgpCgpyZXBldGljb2VzID0gMzAwMAoKYm9vdHN0cmFwX3EyIDwtIGZ1bmN0aW9uKGRzKSB7CiAgZHMgPSBkcyAlPiUgbXV0YXRlKG5ld3NfcHJvcCA9IG5ld3MvKG5ld3MgKyBvbGQpKQogIAogIGJvb3RzdHJhcCA8LSBzYW1wbGVfbihkcywgCiAgICAgICAgICAgICAgICAgICAgICAgIHNpemUgPSBOUk9XKG5ld3NfcHJvcCksIAogICAgICAgICAgICAgICAgICAgICAgICByZXBsYWNlID0gVFJVRSkKICAKICByZXR1cm4oY29yKGJvb3RzdHJhcCRuZXdzX3Byb3AsIGJvb3RzdHJhcCRtZWRpYW5hX3BvcCkpCn0KCnJlYW1vc3RyYWdlbnMgPSB0aWJibGUoaSA9IDE6cmVwZXRpY29lcykgJT4lIAogICAgbXV0YXRlKHRoZXRhX2NfcyA9IG1hcF9kYmwoaSwgfiBib290c3RyYXBfcTIobGFzdGZtX3EyKSkpCgpncmFmX3JlYW1vc3RyYWdlbnNfcTIgPSByZWFtb3N0cmFnZW5zICU+JQogIGdncGxvdChhZXMoeCA9IHRoZXRhX2NfcykpICsKICBnZW9tX2hpc3RvZ3JhbShiaW53aWR0aCA9IC4wMSwKICAgICAgICAgICAgICAgICBjb2xvdXIgPSAiYmxhY2siLAogICAgICAgICAgICAgICAgIGZpbGwgPSAicGluayIpCgpnZ3Bsb3RseShncmFmX3JlYW1vc3RyYWdlbnNfcTIpCmBgYApDb21vIGjDoSBtZW5vcyBlbGVtZW50b3MgZW0gY2FkYSBjbGFzc2Ugb2NvcnJlcmFtIG1haXMgcmVzdWx0YWRvcyBkaWZlcmVudGVzIHF1YW5kbyBjb21wYXJhbW9zIGNvbSBhIHZpc3VhbGl6YcOnw6NvIGRhcyByZWFtb3N0cmFnZW5zIGZlaXRhcyBuYSBxdWVzdMOjbyBhbnRlcmlvci4gUGVyY2ViZS1zZSB0YW1iw6ltIHF1ZSBhIGNvcnJlbGHDp8OjbyDDqSBwcsOzeGltYSBiZW0gcHLDs3hpbWEgZGUgMCBlbSB0b2RhcyBhcyByZWFtb3N0cmFnZW5zLgoKQ2FsY3VsYW5kbyBvIElDOgpgYGB7cn0Kc2V0LnNlZWQoOTA5OCkKCmljX3EyID0gcmVhbW9zdHJhZ2VucyAlPiUgCiAgbXV0YXRlKGVycm8gPSB0aGV0YV9jX3MgLSB0aGV0YV9jKSAlPiUgCiAgc3VtbWFyaXNlKGVycm9faSA9IHF1YW50aWxlKGVycm8sIC4wNSksIAogICAgICAgICAgICBlcnJvX3MgPSBxdWFudGlsZShlcnJvLCAuOTUpKQoKaWNfcTIgPSBpY19xMiAlPiUgCiAgbXV0YXRlKHZhbG9yX2kgPSB0aGV0YV9jICsgZXJyb19pLCAKICAgICAgICAgdmFsb3JfcyA9IHRoZXRhX2MgKyBlcnJvX3MpCgoKaWNfcTIKYGBgCgpWaXN1YWxpemFuZG8gZXNzZSBJQzoKYGBge3J9CmdyYWZfaWNfcTIgPSBnZ3Bsb3QoKSArCiAgZ2VvbV9yZWN0KAogICAgZGF0YSA9IGljX3EyLAogICAgYWVzKHhtaW4gPSB2YWxvcl9pLCB4bWF4ID0gdmFsb3JfcyksCiAgICB5bWluID0gLUluZiwKICAgIHltYXggPSBJbmYsCiAgICBmaWxsID0gImxpZ2h0Z3JlZW4iLAogICAgYWxwaGEgPSAuMjUKICApICsKICBnZW9tX2hpc3RvZ3JhbSgKICAgIGRhdGEgPSByZWFtb3N0cmFnZW5zLAogICAgYWVzKHRoZXRhX2NfcyksCiAgICBiaW53aWR0aCA9IC4wMSwKICAgIGZpbGwgPSAicGluayIsCiAgICBjb2xvdXIgPSAiYmxhY2siCiAgKSArCiAgZ2VvbV92bGluZSh4aW50ZXJjZXB0ID0gdGhldGFfYywgY29sb3IgPSAiYmx1ZSIpCgpncmFmX2ljX3EyCmBgYApPYnNlcnZhbW9zIGNvbSA5NSUgZGUgY29uZmlhbsOnYSBxdWUsIGEgY29ycmVsYcOnw6NvIGVudHJlIGEgcG9wdWxhcmlkYWRlIG1lZGlhbmEgZG9zIGFydGlzdGFzIGVzY3V0YWRvIGUgYSBwcm9wb3LDp8OjbyBkb3MgYXJ0aXN0YXMgZXNjdXRhZG9zIHF1ZSBlcmFtIG5vdm9zIGVzdMOhIGVzdGltYWRhIGVudHJlIC0wLDIgZSAwLDAyNi4gQ29tbyBlc3NlIGludGVydmFsbyBjb250w6ltIG8gdmFsb3IgMCwgcG9kZS1zZSBhZmlybWFyIHF1ZSwgY2FzbyBhIGNvcnJlbGHDp8OjbyBleGlzdGEgKHBvZGUgYWNvbnRlY2VyIGRhIGNvcnJlbGHDp8OjbyBzZXIgemVybyksIGVsYSDDqSBiZW0gcHLDs3hpbW8gZGUgemVyby4KCkFnb3JhLCB2YW1vcyBjb21wYXJhciB1dGlsaXphbmRvIG8gYm9vdHN0cmFwcGVyIGRhIGJpYmxpb3RlY2EgYm9vdDoKYGBge3J9CnNldC5zZWVkKDkwOTgpCgp0aGV0YSA8LSBmdW5jdGlvbihkLCBpKSB7CiAgICBkID0gZCAlPiUgc2xpY2UoaSkgJT4lCiAgICAgICAgbXV0YXRlKG5ld3NfcHJvcCA9IG5ld3MvKG5ld3MgKyBvbGQpKSAlPiUgCiAgICAgICAgc3VtbWFyaXNlKGNvciA9IGNvcihuZXdzX3Byb3AsIG1lZGlhbmFfcG9wKSkKICAgIAogICAgYyA9IGQgJT4lIHB1bGwoY29yKQogICAgYwp9Cgpib290ZWQgPSBib290KGRhdGEgPSBsYXN0Zm1fcTIsCiAgICAgICAgICAgICAgc3RhdGlzdGljID0gdGhldGEsCiAgICAgICAgICAgICAgUiA9IDMwMDApCgpjaSA9IHRpZHkoYm9vdGVkLCAKICAgICAgICAgIGNvbmYubGV2ZWwgPSAuOTUsCiAgICAgICAgICBjb25mLm1ldGhvZCA9ICJiY2EiLAogICAgICAgICAgY29uZi5pbnQgPSBUUlVFKQoKZ2xpbXBzZShjaSkKYGBgCkNvbSB1bSBib290c3RyYXBwZXIgasOhIGltcGxlbWVudGFkbywgb2J0ZW1vcyBxdWUsIGNvbSA5NSUgZGUgY29uZmlhbsOnYSwgYSBjb3JyZWxhw6fDo28gZW50cmUgYSBwb3B1bGFyaWRhZGUgbWVkaWFuYSBkb3MgYXJ0aXN0YXMgZXNjdXRhZG8gZSBhIHByb3BvcsOnw6NvIGRvcyBhcnRpc3RhcyBlc2N1dGFkb3MgcXVlIGVyYW0gbm92b3MgZXN0w6EgZXN0aW1hZGEgZW50cmUgLTAsMjMgZSAwLDA0MSUuIE5vdmFtZW50ZSBwZXJjZWJlbW9zIHF1ZSBvIHplcm8gZXN0w6EgY29udGlkbyBubyBpbnRlcnZhbG8sIG8gcXVlIGluZGljYSBxdWUgYSBjb3JyZWxhw6fDo28gcG9kZSBuw6NvIGV4aXN0aXIgb3Ugc2VyIG11aXRvIGJhaXhhLg==